home *** CD-ROM | disk | FTP | other *** search
/ Meeting Pearls 2 / Meeting Pearls Vol. II (1995)(GTI - Schatztruhe)[!].iso / Pearls / dev / Oberon4Amiga / Dialogs / DialogIntegerSliders.Mod (.txt) < prev    next >
Oberon Text  |  1994-11-28  |  7KB  |  145 lines

  1. Syntax10.Scn.Fnt
  2. Syntax10i.Scn.Fnt
  3. StampElems
  4. Alloc
  5. 2 Nov 94
  6. Syntax10b.Scn.Fnt
  7. ParcElems
  8. Alloc
  9. MODULE DialogIntegerSliders;
  10.     (** Markus Knasm
  11. ller 31 Aug 94 - 
  12.     IMPORT DialogFrames, Dialogs, DialogSliders, DialogTexts, Display, Fonts, GraphicUtils, In, Oberon, TextFrames, Texts, Viewers;
  13.     CONST backCol = DialogSliders.backCol; patternCol = backCol; W* = 70; H* = 20; MM = 1; ML = 0; MR =2;
  14.     TYPE
  15.         Item* = POINTER TO ItemDesc;
  16.         ItemDesc* = RECORD (DialogSliders.ItemDesc)
  17.         END;
  18.         minusArrow*, plusArrow*: Display.Pattern;
  19.         minusArrowImage, plusArrowImage: ARRAY 10 OF SET;
  20.         fnt: Fonts.Font;
  21.     PROCEDURE Max (x, y: INTEGER): INTEGER;
  22.     BEGIN IF x > y THEN RETURN x ELSE RETURN y END
  23.     END Max;
  24.     PROCEDURE Min (x, y: INTEGER): INTEGER;
  25.     BEGIN IF x < y THEN RETURN x ELSE RETURN y END
  26.     END Min;
  27.     PROCEDURE (s: Item) Copy* (VAR dup: Dialogs.Object);
  28.     (** allocates dup and makes a deep copy of o. Before calling this methode dup should be equal NIL *)
  29.         VAR x: Item; 
  30.     BEGIN IF dup = NIL THEN NEW (x); dup := x ELSE x := dup(Item) END; s.Copy^ (dup); 
  31.     END Copy;
  32.     PROCEDURE (s: Item) MaxValue* (): INTEGER;
  33.     (** returns the highest possible value of sliderdY *)
  34.     BEGIN RETURN MAX (INTEGER);
  35.     END MaxValue;
  36.     PROCEDURE IntToChar (x0: INTEGER; VAR a: ARRAY OF CHAR);
  37.         VAR i, j: INTEGER; b: ARRAY 11 OF CHAR;
  38.     BEGIN 
  39.         i := 0; x0 := Max (0, x0);
  40.         REPEAT
  41.             b[i] := CHR(x0 MOD 10 + 30H); x0 := x0 DIV 10; INC(i)
  42.         UNTIL x0 = 0;
  43.         FOR j := 0 TO i - 1 DO
  44.             a[j] := b[i -1 - j]
  45.         END;
  46.         a[i] := 0X
  47.     END IntToChar;
  48.     PROCEDURE (s: Item) Arrow* (down: BOOLEAN): Display.Pattern;
  49.     BEGIN
  50.         IF down THEN RETURN (minusArrow) ELSE RETURN (plusArrow) END
  51.     END Arrow;
  52.     PROCEDURE (s: Item) DrawSlider* (f: Display.Frame; pressed : BOOLEAN; x, y, w, h, mode : INTEGER);
  53.     (** displays the slider of the item at (x, y) in frame f *)
  54.         VAR dummy: INTEGER; arr: ARRAY 11 OF CHAR; bgPat: Display.Pattern;
  55.     BEGIN
  56.         Display.ReplConstC (f, backCol, x, y , w, h, Display.replace); IntToChar (s.sliderdY, arr); 
  57.         IF h > w THEN bgPat := DialogSliders.vBgPat ELSE bgPat := DialogSliders.hBgPat END;
  58.         Display.ReplPatternC (f, patternCol, bgPat, x, y, w, h, 0, 0, mode);
  59.         y := y + (h DIV 2) - (fnt.maxY DIV 2);
  60.         GraphicUtils.DrawString (f, arr, x, y, w, fnt, mode, dummy) 
  61.     END DrawSlider;
  62.     PROCEDURE (s: Item) MoveSlider* (f: Display.Frame; pressed: BOOLEAN; dY: INTEGER);
  63.     (** changes the displayed value to dY *)
  64.         VAR dummy, x, y, w, h: INTEGER; arr: ARRAY 11 OF CHAR; bgPat: Display.Pattern;
  65.     BEGIN
  66.         s.GetDim (x, y, w, h); x := x + f.X; y := y + f.Y + f.H;
  67.         IF w > h THEN x := x + h; w := w - 2 * h ELSE y := y + w; h := h - 2 * w END;
  68.         Display.ReplConstC (f, backCol, x, y , w, h, Display.replace); IntToChar (dY, arr); 
  69.         IF h > w THEN bgPat := DialogSliders.vBgPat ELSE bgPat := DialogSliders.hBgPat END;
  70.         Display.ReplPatternC (f, patternCol, bgPat, x, y, w, h, 0, 0, Display.paint);
  71.         y := y + (h DIV 2) - (fnt.maxY DIV 2);
  72.         GraphicUtils.DrawString (f, arr, x, y, w, fnt, Display.paint, dummy) 
  73.     END MoveSlider;
  74.     PROCEDURE (s: Item) PrintSlider* (x, y, w, h: INTEGER);
  75.     (** prints the slider of the item at printer coordinates (x, y) *)
  76.         VAR dummy: INTEGER; arr: ARRAY 11 OF CHAR;
  77.     BEGIN
  78.         GraphicUtils.PrintBox (x, y, w,h); IntToChar (s.sliderdY, arr); 
  79.         y := y + (h DIV 2) - (SHORT (fnt.maxY * Dialogs.dUnit DIV Dialogs.pUnit) DIV 2);
  80.         GraphicUtils.PrintString (arr, x, y, w, fnt, dummy) 
  81.     END PrintSlider;
  82.     PROCEDURE (s: Item) CheckdY* (VAR dY: INTEGER);
  83.     (** checks whether dY is a possible value for sliderdY *)
  84.     BEGIN dY := Max (0, dY)
  85.     END CheckdY;
  86.     PROCEDURE (s: Item) TrackScrollBar* (f: Display.Frame; mx, my : INTEGER; keys : SET);
  87.     (** handles mouse events concerning the full scrollbar *)    
  88.         VAR x, y, w, h : INTEGER; t1: Texts.Text;
  89.     BEGIN
  90.         s.GetDim (x, y, w, h); x := x + f.X; y := y + f.Y + f.H;
  91.         IF ((keys = {MM}) OR (keys = {ML}) OR (keys = {MR})) & (Max (w, h) >= 2 * Min (w, h)) THEN    
  92.             Oberon.RemoveMarks (x, y, w, h);
  93.             IF w > h THEN
  94.                 IF mx < x + h THEN s.TrackButton (f, x, y, h, mx, my, keys, TRUE)
  95.                 ELSIF mx >= x + w - h THEN s.TrackButton (f, x + w - h, y, h, mx, my, keys, FALSE)
  96.                 END 
  97.             ELSE
  98.                 IF my < y + w THEN s.TrackButton (f, x, y, w, mx, my, keys, TRUE)
  99.                 ELSIF my >= y + h - w THEN s.TrackButton (f, x, y + h - w, w, mx, my, keys, FALSE)
  100.                 END
  101.             END;
  102.             IF (keys = {MM}) OR (keys = {ML}) OR (keys = {MR}) & (s.cmd[0] # 0X) THEN
  103.                 DialogTexts.GetParText (s.par, s.panel, t1);
  104.                 s.CallCmd (f, Viewers.This (x,y), t1)
  105.             END
  106.         END
  107.     END TrackScrollBar;
  108.     PROCEDURE Insert*;
  109.     (** Insert ([name] [x y w h] | ^ ) inserts a integerslider - item in the panel containing the caret position *)
  110.         VAR x, y, x1, y1, w, h: INTEGER; p : Dialogs.Panel; s: Item; name: ARRAY 64 OF CHAR;
  111.     BEGIN
  112.         NEW (s); 
  113.         DialogFrames.GetCaretPosition (p, x, y);
  114.         IF (p # NIL) THEN
  115.             s.Init; In.Open; In.Name (name);
  116.             IF ~In.Done THEN COPY ("", name); In.Open END;
  117.             s.SetName (name); 
  118.             In.Int (x1); In.Int (y1); In.Int (w); In.Int (h);
  119.             IF ~In.Done THEN x1 := x; y1 := y; w := W; h := H 
  120.             ELSE
  121.                 IF w < 0 THEN w := W END;
  122.                 IF h < 0 THEN h := H END
  123.             END;
  124.             s.SetDim (x1, y1, w, h, FALSE); p.Insert (s, FALSE)
  125.         ELSE
  126.             Dialogs.res := Dialogs.noPanelSelected
  127.         END;
  128.         IF Dialogs.res # 0 THEN Dialogs.Error ("DialogIntegerSliders") END;
  129.     END Insert;
  130. BEGIN
  131.     minusArrowImage[0] := {};    plusArrowImage[0] := {};
  132.     minusArrowImage[1] := {};    plusArrowImage[1] := {3..5};
  133.     minusArrowImage[2] := {};    plusArrowImage[2] := {3..5};
  134.     minusArrowImage[3] := {};    plusArrowImage[3] := {3..5};
  135.     minusArrowImage[4] := {0..8};    plusArrowImage[4] := {0..8};
  136.     minusArrowImage[5] := {0..8};    plusArrowImage[5] := {0..8};
  137.     minusArrowImage[6] := {0..8};    plusArrowImage[6] := {0..8};
  138.     minusArrowImage[7] := {};    plusArrowImage[7] := {3..5};
  139.     minusArrowImage[8] := {};    plusArrowImage[8] := {3..5};
  140.     minusArrowImage[9] := {};    plusArrowImage[9] := {3..5};
  141.     minusArrow := Display.NewPattern (minusArrowImage, 9, 9);
  142.     plusArrow := Display.NewPattern (plusArrowImage, 9, 9);
  143.     fnt := Fonts.This ("Syntax12b.Scn.Fnt")
  144. END DialogIntegerSliders.
  145.